home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / langs / xlisp2.1 / xldist02.zoo / sources / xlisp.h < prev    next >
Encoding:
C/C++ Source or Header  |  1991-05-03  |  20.3 KB  |  652 lines
  1. /* xlisp - a small subset of lisp */
  2. /*        Copyright (c) 1985, by David Michael Betz
  3.         All Rights Reserved
  4.         Permission is granted for unrestricted non-commercial use        */
  5.  
  6. /* system specific definitions */
  7.  
  8. #include <stdio.h>
  9. #include <ctype.h>
  10. #include <setjmp.h>
  11.  
  12. /* NNODES        number of nodes to allocate in each request (1000) */
  13. /* EDEPTH        evaluation stack depth (2000) */
  14. /* ADEPTH        argument stack depth (1000) */
  15. /* FORWARD        type of a forward declaration () */
  16. /* LOCAL        type of a local function (static) */
  17. /* AFMT            printf format for addresses ("%x") */
  18. /* FIXTYPE        data type for fixed point numbers (long) */
  19. /* ITYPE        fixed point input conversion routine type (long atol()) */
  20. /* ICNV            fixed point input conversion routine (atol) */
  21. /* IFMT            printf format for fixed point numbers ("%ld") */
  22. /* FLOTYPE        data type for floating point numbers (float) */
  23. /* OFFTYPE        number the size of an address (int) */
  24.  
  25. /* Costs indicated for Borland Turbo C++ V1.0 (as a C compiler) */
  26.  
  27. #define ADDEDTAA    /* added functions by TAA: GENERIC TIME COUNT-IF FIND-IF
  28.                         (2.2k) */
  29. #define BETTERIO    /* improved io (binary files, file positioning)
  30.                         (1.3k) */
  31. #define PRINDEPTH    /* added ability to control print depth (384 bytes)*/
  32. #define OBJPRNT        /* friendly object printing feature TAA and
  33.                         Mikael Pettersson, Dept. of Computer and Info. 
  34.                         Science, University of Linkoping, Sweden 
  35.                         (944 bytes) */
  36. #define ENHFORMAT    /* enhanced FORMAT function (Neal Holtz) (1.3k)*/
  37. #define JMAC        /* performance enhancing macros, Johnny Greenblatt 
  38.                        (7.5K at full config) */
  39. #define JGC            /* improved garbage collection, Johnny Greenblatt 
  40.                         (48 bytes!)*/
  41.  
  42. /* using dldmem.c and dlimage.c adds 1184 bytes of code */
  43.  
  44. #define COMMONLISP    /* more CommonLisp like definitions for some functions */
  45.             /* as well as functions ELT SEARCH MAP COERCE POSITION-IF
  46.                 CONCATENATE SOME EVERY NOTANY NOTEVERY; 
  47.                        function XLSTRCAT is deleted (11.5k)*/
  48. #define STRUCTS        /* DEFSTRUCT (xlisp 2.1) (7.5k)*/
  49. #define APPLYHOOK    /* adds applyhook support, strangely missing before 
  50.                        (1312 bytes)*/
  51.  
  52.  
  53. /*#define PROFILES    */ /* for execution profiles */
  54. #ifdef PROFILES
  55. #define LOCAL        /*no local procedures*/
  56. #endif
  57.  
  58.  
  59. /* for BSD & SYSV Unix. */
  60. #ifdef UNIX
  61. #define NNODES        2000
  62. #define AFMT        "%lx"    /* added by NPM */
  63. #define OFFTYPE        long    /* added by NPM */
  64. #define SAVERESTORE
  65.  
  66. #else
  67.  
  68. /* The following two options are only available for the compilers noted
  69.    below */
  70.  
  71. #define BUFFERED    /* Makes code slightly bigger, but screen writing 
  72.                         much faster when nansi.sys or fansi-console used 
  73.                         (384 bytes)*/ 
  74. #define GRAPHICS    /* add graphics commands 
  75.                         MODE COLOR MOVE DRAW MOVEREL DRAWREL 
  76.                         (2.7k) */
  77. #endif /* UNIX */
  78.  
  79.  
  80. /* for Zortech C  -- Versions after 1988 only */
  81. /* BUFFERED and GRAPHICS ok */
  82. #ifdef __ZTC__
  83. #define ANSI
  84. #define NNODES            2000
  85. #define EDEPTH            650        /* stacksize/25 is appropriate */
  86. #define AFMT            "%lx"
  87. #define OFFTYPE            long
  88. #define SAVERESTORE
  89. #define CVPTR(x)        ((((unsigned long)(x) >> 16) << 4) + ((unsigned) x))
  90. #endif
  91.  
  92.  
  93. /* for the Turbo C compiler - MS-DOS, large model */
  94. /* Version 1.5 and 2.0.     1.5 won't compile with ADDEDTAA */
  95. /* BUFFERED and GRAPHICS ok */
  96. #ifdef __TURBOC__
  97. #define ANSI
  98. #define NNODES            2000
  99. #define EDEPTH            650        /* stacksize/25 is appropriate */
  100. #define AFMT            "%lx"
  101. #define OFFTYPE            long
  102. #define CVPTR(x)        ((((unsigned long)(x) >> 16) << 4) + ((unsigned) x))
  103. #define SAVERESTORE
  104. #endif
  105.  
  106. /* for the Microsoft C compiler - MS-DOS, large model */
  107. /* Version 5.0.     Should work with earlier as well */
  108. /* BUFFERED and GRAPHICS ok */
  109. #ifdef MSC
  110. #define ANSI
  111. #define NNODES            2000
  112. #define EDEPTH            650
  113. #define AFMT            "%lx"
  114. #define OFFTYPE            long
  115. #define CVPTR(x)        ((((unsigned long)(x) >> 16) << 4) + ((unsigned) x))
  116. #define SAVERESTORE
  117. #endif
  118.  
  119. /* for 80386, Metaware High-C386 */
  120. /* BUFFERED and GRAPHICS ok -- Special fast graphics code, this
  121.    version works only for EGA/VGA/Enhanced EorVGA modes! */
  122. #ifdef __HIGHC__
  123. /* default EDEPTH=2000, at stacksize/34, requires stack of 68000 */
  124. #define EDEPTH 4000    /* want deeper stack yet.. 136k system stack */
  125. #define ANSI
  126. #define ADEPTH    6000
  127. #define NNODES    2000
  128. #define FLOTYPE double
  129. #define SAVERESTORE
  130. #define ftell myftell            /* ftell is broken at least through v1.62) */
  131. extern long myftell(FILE *fp);
  132. #endif
  133.  
  134. /* for NDP386 system */
  135. #ifdef NDP386
  136. #define ADEPTH    3000
  137. #define NNODES    2000
  138. #define FLOTYPE double
  139. #define SAVERESTORE
  140. /* these definitions point out the deficiencies of NDP */
  141. extern void *malloc();
  142. extern void *calloc();
  143. extern void free();
  144. #define  SEEK_CUR 1
  145. #define  SEEK_END 2
  146. #define  SEEK_SET 0
  147. #undef GRAPHICS
  148. #undef BUFFERED
  149. #endif
  150.  
  151.  
  152. /* for the AZTEC C compiler - MS-DOS, large model */
  153. #ifdef AZTEC_LM
  154. #define NNODES            2000
  155. #define AFMT            "%lx"
  156. #define OFFTYPE            long
  157. #define CVPTR(x)        ptrtoabs(x)
  158. #define NIL                (void *)0
  159. extern long ptrtoabs();
  160. #define SAVERESTORE
  161. #endif
  162.  
  163. /* for the AZTEC C compiler - Macintosh */
  164. #ifdef AZTEC_MAC
  165. #define NNODES            2000
  166. #define AFMT            "%lx"
  167. #define OFFTYPE            long
  168. #define NIL                (void *)0
  169. #define SAVERESTORE
  170. #endif
  171.  
  172. /* for the AZTEC C compiler - Amiga */
  173. #ifdef AZTEC_AMIGA
  174. #define NNODES            2000
  175. #define AFMT            "%lx"
  176. #define OFFTYPE            long
  177. #define NIL                (void *)0
  178. #define SAVERESTORE
  179. #endif
  180.  
  181. /* for the Lightspeed C compiler - Macintosh */
  182. #ifdef LSC
  183. #define NNODES            2000
  184. #define AFMT            "%lx"
  185. #define OFFTYPE            long
  186. #define NIL                (void *)0
  187. #define SAVERESTORE
  188. #endif
  189.  
  190.  
  191. /* for the Mark Williams C compiler - Atari ST */
  192. #ifdef MWC
  193. #define AFMT            "%lx"
  194. #define OFFTYPE            long
  195. #endif
  196.  
  197. /* for the Lattice C compiler - Atari ST */
  198. #ifdef LATTICE
  199. #define FIXTYPE            int
  200. #define ITYPE            int atoi()
  201. #define ICNV(n)            atoi(n)
  202. #define IFMT            "%d"
  203. #endif
  204.  
  205. /* for the Digital Research C compiler - Atari ST */
  206. #ifdef DR
  207. #define LOCAL
  208. #define AFMT            "%lx"
  209. #define OFFTYPE            long
  210. #undef NULL
  211. #define NULL            0L
  212. #endif
  213.  
  214. /* for the GNU C compiler - Atari ST */
  215. #ifdef atarist
  216. #define NNODES            2000
  217. #define AFMT            "%lx"
  218. #define OFFTYPE            long
  219. #define SAVERESTORE
  220. #endif
  221.  
  222.  
  223. /* default important definitions */
  224. #ifndef NNODES
  225. #define NNODES            1000
  226. #endif
  227. #ifndef EDEPTH
  228. #define EDEPTH            2000
  229. #endif
  230. #ifndef ADEPTH
  231. #define ADEPTH            1000
  232. #endif
  233. #ifndef FORWARD
  234. #define FORWARD
  235. #endif
  236. #ifndef LOCAL
  237. #define LOCAL            static
  238. #endif
  239. #ifndef AFMT
  240. #define AFMT            "%x"
  241. #endif
  242. #ifndef FIXTYPE
  243. #define FIXTYPE            long
  244. #endif
  245. #ifndef ITYPE
  246. #define ITYPE            long atol()
  247. #endif
  248. #ifndef ICNV
  249. #define ICNV(n)            atol(n)
  250. #endif
  251. #ifndef IFMT
  252. #define IFMT            "%ld"
  253. #endif
  254. #ifndef FLOTYPE
  255. #define FLOTYPE            double
  256. #endif
  257. #ifndef OFFTYPE
  258. #define OFFTYPE            int
  259. #endif
  260. #ifndef CVPTR
  261. #define CVPTR(x)        ((OFFTYPE)(x))
  262. #endif
  263. #ifndef VOID
  264. #define VOID            void    
  265. #endif
  266.  
  267. /* useful definitions */
  268. #define TRUE    1
  269. #define FALSE    0
  270. #ifndef NIL
  271. #define NIL        (LVAL )0
  272. #endif
  273.  
  274. /* include the dynamic memory definitions */
  275. #include "xldmem.h"
  276.  
  277. /* program limits */
  278. #define STRMAX            100                /* maximum length of a string constant */
  279. #define HSIZE            199                /* symbol hash table size */
  280. #define SAMPLE            100                /* control character sample rate */
  281.  
  282. /* function table offsets for the initialization functions */
  283. #define FT_RMHASH        0
  284. #define FT_RMQUOTE        1
  285. #define FT_RMDQUOTE        2
  286. #define FT_RMBQUOTE        3
  287. #define FT_RMCOMMA        4
  288. #define FT_RMLPAR        5
  289. #define FT_RMRPAR        6
  290. #define FT_RMSEMI        7
  291. #define FT_CLNEW        10
  292. #define FT_CLISNEW        11
  293. #define FT_CLANSWER        12
  294. #define FT_OBISNEW        13
  295. #define FT_OBCLASS        14
  296. #define FT_OBSHOW        15
  297. #ifdef OBJPRNT
  298. #define FT_OBPRIN1        16
  299. #endif
  300.         
  301. /* macro to push a value onto the argument stack */
  302. #define pusharg(x)        {if (xlsp >= xlargstktop) xlargstkoverflow();\
  303.                          *xlsp++ = (x);}
  304.  
  305. /* macros to protect pointers */
  306. #define xlstkcheck(n)    {if (xlstack - (n) < xlstkbase) xlstkoverflow();}
  307. #define xlsave(n)        {*--xlstack = &n; n = NIL;}
  308. #define xlprotect(n)    {*--xlstack = &n;}
  309.  
  310. /* check the stack and protect a single pointer */
  311. #define xlsave1(n)        {if (xlstack <= xlstkbase) xlstkoverflow();\
  312.                          *--xlstack = &n; n = NIL;}
  313. #define xlprot1(n)        {if (xlstack <= xlstkbase) xlstkoverflow();\
  314.                          *--xlstack = &n;}
  315.  
  316. /* macros to pop pointers off the stack */
  317. #define xlpop()            {++xlstack;}
  318. #define xlpopn(n)        {xlstack+=(n);}
  319.  
  320. /* macros to manipulate the lexical environment */
  321. #define xlframe(e)        cons(NIL,e)
  322. #define xlbind(s,v)        xlpbind(s,v,xlenv)
  323. #define xlfbind(s,v)    xlpbind(s,v,xlfenv);
  324. #define xlpbind(s,v,e)    {rplaca(e,cons(cons(s,v),car(e)));}
  325.  
  326. /* macros to manipulate the dynamic environment */
  327. #define xldbind(s,v)    {xldenv = cons(cons(s,getvalue(s)),xldenv);\
  328.                          setvalue(s,v);}
  329. #define xlunbind(e)        {for (; xldenv != (e); xldenv = cdr(xldenv))\
  330.                            setvalue(car(car(xldenv)),cdr(car(xldenv)));}
  331.  
  332. /* type predicates */                           
  333. #define atom(x)            ((x) == NIL || ntype(x) != CONS)
  334. #define null(x)            ((x) == NIL)
  335. #define listp(x)        ((x) == NIL || ntype(x) == CONS)
  336. #define consp(x)        ((x) && ntype(x) == CONS)
  337. #define subrp(x)        ((x) && ntype(x) == SUBR)
  338. #define fsubrp(x)        ((x) && ntype(x) == FSUBR)
  339. #define stringp(x)        ((x) && ntype(x) == STRING)
  340. #define symbolp(x)        ((x) && ntype(x) == SYMBOL)
  341. #define streamp(x)        ((x) && ntype(x) == STREAM)
  342. #define objectp(x)        ((x) && ntype(x) == OBJECT)
  343. #define fixp(x)            ((x) && ntype(x) == FIXNUM)
  344. #define floatp(x)        ((x) && ntype(x) == FLONUM)
  345. #define vectorp(x)        ((x) && ntype(x) == VECTOR)
  346. #define closurep(x)        ((x) && ntype(x) == CLOSURE)
  347. #define charp(x)        ((x) && ntype(x) == CHAR)
  348. #define ustreamp(x)        ((x) && ntype(x) == USTREAM)
  349. #ifdef STRUCTS
  350. #define structp(x)        ((x) && ntype(x) == STRUCT)
  351. #endif
  352. #define boundp(x)        (getvalue(x) != s_unbound)
  353. #define fboundp(x)        (getfunction(x) != s_unbound)
  354.  
  355. /* shorthand functions */
  356. #define consa(x)        cons(x,NIL)
  357. #define consd(x)        cons(NIL,x)
  358.  
  359. /* argument list parsing macros */
  360. #define xlgetarg()        (testarg(nextarg()))
  361. #define xllastarg()        {if (xlargc != 0) xltoomany();}
  362. #define testarg(e)        (moreargs() ? (e) : xltoofew())
  363. #define typearg(tp)        (tp(*xlargv) ? nextarg() : xlbadtype(*xlargv))
  364. #define nextarg()        (--xlargc, *xlargv++)
  365. #define moreargs()        (xlargc > 0)
  366.  
  367. /* macros to get arguments of a particular type */
  368. #define xlgacons()        (testarg(typearg(consp)))
  369. #define xlgalist()        (testarg(typearg(listp)))
  370. #define xlgasymbol()    (testarg(typearg(symbolp)))
  371. #define xlgasymornil()    (*xlargv==NIL || symbolp(*xlargv) ? nextarg() : xlbadtype(*xlargv))
  372. #define xlgastring()    (testarg(typearg(stringp)))
  373. #ifdef COMMONLISP
  374. #define xlgastrorsym()    (testarg(symbolp(*xlargv) ? getpname(nextarg()) : typearg(stringp)))
  375. #else
  376. #define xlgastrorsym()    xlgastring()
  377. #endif
  378. #define xlgaobject()    (testarg(typearg(objectp)))
  379. #define xlgafixnum()    (testarg(typearg(fixp)))
  380. #define xlgaflonum()    (testarg(typearg(floatp)))
  381. #define xlgachar()        (testarg(typearg(charp)))
  382. #define xlgavector()    (testarg(typearg(vectorp)))
  383. #define xlgastream()    (testarg(typearg(streamp)))
  384. #define xlgaustream()    (testarg(typearg(ustreamp)))
  385. #define xlgaclosure()    (testarg(typearg(closurep)))
  386. #ifdef STRUCTS
  387. #define xlgastruct()    (testarg(typearg(structp)))
  388. #endif
  389.  
  390.  
  391. /* function definition structure */
  392. typedef struct {
  393.     char *fd_name;        /* function name */
  394.     int fd_type;        /* function type */
  395.     LVAL (*fd_subr)();    /* function entry point */
  396. } FUNDEF;
  397.  
  398. /* execution context flags */
  399. #define CF_GO            0x0001
  400. #define CF_RETURN        0x0002
  401. #define CF_THROW        0x0004
  402. #define CF_ERROR        0x0008
  403. #define CF_CLEANUP        0x0010
  404. #define CF_CONTINUE        0x0020
  405. #define CF_TOPLEVEL        0x0040
  406. #define CF_BRKLEVEL        0x0080
  407. #define CF_UNWIND        0x0100
  408.  
  409. /* execution context */
  410. typedef struct context {
  411.     int c_flags;                        /* context type flags */
  412.     LVAL c_expr;                        /* expression (type dependant) */
  413.     jmp_buf c_jmpbuf;                    /* longjmp context */
  414.     struct context *c_xlcontext;        /* old value of xlcontext */
  415.     LVAL **c_xlstack;                    /* old value of xlstack */
  416.     LVAL *c_xlargv;                        /* old value of xlargv */
  417.     int c_xlargc;                        /* old value of xlargc */
  418.     LVAL *c_xlfp;                        /* old value of xlfp */
  419.     LVAL *c_xlsp;                        /* old value of xlsp */
  420.     LVAL c_xlenv;                        /* old value of xlenv */
  421.     LVAL c_xlfenv;                        /* old value of xlfenv */
  422.     LVAL c_xldenv;                        /* old value of xldenv */
  423. } CONTEXT;
  424.  
  425. /* external variables */
  426. extern LVAL **xlstktop;            /* top of the evaluation stack */
  427. extern LVAL **xlstkbase;        /* base of the evaluation stack */
  428. extern LVAL **xlstack;            /* evaluation stack pointer */
  429. extern LVAL *xlargstkbase;        /* base of the argument stack */
  430. extern LVAL *xlargstktop;        /* top of the argument stack */
  431. extern LVAL *xlfp;                /* argument frame pointer */
  432. extern LVAL *xlsp;                /* argument stack pointer */
  433. extern LVAL *xlargv;            /* current argument vector */
  434. extern int xlargc;                /* current argument count */
  435.  
  436. #ifdef ANSI
  437. /* We need to be more thorough here!*/
  438. /* OS system interface */
  439.  
  440. extern VOID oscheck(void);        /* check for control character during exec */
  441. extern VOID osinit(char *banner);    /* initialize os interface */
  442. extern VOID osfinish(void);        /* restore os interface */
  443. extern VOID osflush(void);        /* flush terminal input buffer */
  444. extern int  osrand(int n);        /* random number between 0 and n-1 */
  445. extern int  osclose(FILE *fp);    /* close file */
  446. extern FILE *osaopen(char *name, char *mode);    /* open ascii file */
  447. extern FILE *osbopen(char *name, char *mode);    /* open binary file */
  448. extern VOID oserror(char *msg);    /* print an error message */
  449. extern int  ostgetc(void);        /* get a character from the terminal */
  450. extern VOID ostputc(int ch);    /* put a character to the terminal */
  451.  
  452. /* for xlisp.c */
  453. extern void xlrdsave(LVAL expr);
  454. extern void xlevsave(LVAL expr);
  455. extern void xlfatal(char *msg);
  456. extern void wrapup(void);
  457.  
  458. /* for xleval */
  459. extern LVAL xlxeval(LVAL expr);
  460. extern void xlabind(LVAL fun, int argc, LVAL *argv);
  461. extern void xlfunbound(LVAL sym);
  462. extern void xlargstkoverflow(void);
  463. extern int  macroexpand(LVAL fun, LVAL args, LVAL *pval);
  464. extern int  pushargs(LVAL fun, LVAL args);
  465. extern LVAL makearglist(int argc, LVAL *argv);
  466. extern void xlunbound(LVAL sym);
  467. extern void xlstkoverflow(void);
  468.  
  469. /* for xlio */
  470. extern int xlgetc(LVAL fptr);
  471. extern void xlungetc(LVAL fptr, int ch);
  472. extern int xlpeek(LVAL fptr);
  473. extern void xlputc(LVAL fptr, int ch);
  474. extern void xlflush(void);
  475. extern void stdprint(LVAL expr);
  476. extern void stdputstr(char *str);
  477. extern void errprint(LVAL expr);
  478. extern void errputstr(char *str);
  479. extern void dbgprint(LVAL expr);
  480. extern void dbgputstr(char *str);
  481. extern void trcprin1(LVAL expr);
  482. extern void trcputstr(char *str);
  483.  
  484. /* for xlprin */
  485. extern void xlputstr(LVAL fptr, char *str);
  486. extern void xlprint(LVAL fptr, LVAL vptr, int flag);
  487. extern void xlterpri(LVAL fptr);
  488. extern void xlputstr(LVAL fptr, char* str);
  489.  
  490. /* for xljump */
  491. extern void xljump(CONTEXT *target, int mask, LVAL val);
  492. extern void xlbegin(CONTEXT *cptr, int flags, LVAL expr);
  493. extern void xlend(CONTEXT *cptr);
  494. extern void xlgo(LVAL label);
  495. extern void xlreturn(LVAL name, LVAL val);
  496. extern void xlthrow(LVAL tag, LVAL val);
  497. extern void xlsignal(char *emsg, LVAL arg);
  498. extern void xltoplevel(void);
  499. extern void xlbrklevel(void);
  500. extern void xlcleanup(void);
  501. extern void xlcontinue(void);
  502.  
  503. /* for xllist */
  504. extern int dotest2(LVAL arg1, LVAL arg2, LVAL fun);
  505.  
  506. /* for xlsubr */
  507. extern int xlgetkeyarg(LVAL key, LVAL *pval);
  508. extern int xlgkfixnum(LVAL key, LVAL *pval);
  509. extern void xltest(LVAL *pfcn, int *ptresult);
  510. extern int needsextension(char *name);
  511. extern int eql(LVAL arg1, LVAL arg2);
  512. extern int equal(LVAL arg, LVAL arg2);
  513.  
  514. /* for xlobj */
  515. extern int xlobsetvalue(LVAL pair, LVAL sym, LVAL val);
  516. extern int xlobgetvalue(LVAL pair, LVAL sym, LVAL *pval);
  517. #ifdef OBJPRNT
  518. extern void putobj(LVAL fptr, LVAL obj);
  519. #endif
  520.  
  521. /* for xlread */
  522. extern LVAL tentry(int ch);
  523. extern int xlload(char *fname, int vflag, int pflag);
  524. extern int xlread(LVAL fptr, LVAL *pval);
  525. extern int isnumber(char *str, LVAL *pval);
  526.  
  527. #ifdef STRUCTS
  528. /* for xlstruct */
  529. extern LVAL xlrdstruct(LVAL list);
  530. extern void xlprstruct(LVAL fptr, LVAL vptr, int flag);
  531. #endif
  532.  
  533. /* save/restore functions */
  534. #ifdef SAVERESTORE
  535. extern int xlirestore(char *fname);
  536. extern int xlisave(char *fname);
  537. #endif
  538.  
  539. /* external procedure declarations */
  540. extern VOID obsymbols(void);    /* initialize oop symbols */
  541. extern VOID ossymbols(void);    /* initialize os symbols */
  542. extern VOID xlsymbols(void);    /* initialize interpreter symbols */
  543. extern VOID xloinit(void);        /* initialize object functions */
  544. extern VOID xlsinit(void);        /* initialize xlsym.c */
  545. extern VOID xlrinit(void);        /* initialize xlread.c */
  546. extern VOID xlminit(void);        /* init xldmem */
  547. extern VOID xldinit(void);        /* initilaixe debugger */
  548. extern  int xlinit(int nores);    /* xlisp initialization routine */
  549. extern LVAL xleval(LVAL expr);    /* evaluate an expression */
  550. extern LVAL xlapply(int argc);    /* apply a function to arguments */
  551. extern LVAL xlsubr(char *sname, int type, LVAL (*fcn)(void),int offset);
  552.                                 /* enter a subr/fsubr */
  553. extern LVAL xlenter(char *name);/* enter a symbol */
  554. extern LVAL xlmakesym(char *name);    /* make an uninterned symbol */
  555. extern LVAL xlgetvalue(LVAL sym);    /* get value of a symbol (checked) */
  556. extern void xlsetvalue(LVAL sym, LVAL val); /* set the value of symbol */
  557. extern LVAL xlxgetvalue(LVAL sym);    /* get value of a symbol */
  558. extern LVAL xlgetfunction(LVAL sym);/* get functional value of a symbol */
  559. extern LVAL xlxgetfunction(LVAL sym);
  560.                             /* get functional value of a symbol (checked) */
  561. extern void xlsetfunction(LVAL sym, LVAL val);    /* set the functional value */
  562. extern LVAL xlexpandmacros(LVAL form);        /* expand macros in a form */
  563. extern LVAL xlgetprop(LVAL sym, LVAL prp);    /* get the value of a property */
  564. extern void xlputprop(LVAL sym, LVAL val, LVAL prp); /*set value of property*/
  565. extern void xlremprop(LVAL sym, LVAL prp);    /* remove a property */
  566. extern LVAL xlclose(LVAL name, LVAL type, LVAL fargs, LVAL body, LVAL env, LVAL fenv);
  567.                                 /* create a function closure */
  568. extern int hash(char *str, int len);    /* Hash the string */
  569.  
  570. /* argument list parsing functions */
  571. extern LVAL xlgetfile(void);    /* get a file/stream argument */
  572. extern LVAL xlgetfname(void);    /* get a filename argument */
  573.  
  574. /* error reporting functions (don't *really* return at all) */
  575. extern LVAL xltoofew(void);        /* report "too few arguments" error */
  576. extern void xltoomany(void);    /* report "too many arguments" error */
  577. extern LVAL xlbadtype(LVAL arg);/* report "bad argument type" error */
  578. extern LVAL xlerror(char *emsg, LVAL arg);    /* report arbitrary error */
  579. extern void xlcerror(char *cmsg, char *emsg, LVAL arg); /*recoverable error*/
  580. extern void xlerrprint(char *hdr,char *cmsg, char *emsg, LVAL arg);
  581. extern void xlbaktrace(int n);    /* do a backtrace */
  582. extern void xlabort(char *emsg);    /* serious error handler */
  583. extern void xlfail(char *emsg);        /* xlisp error handler */
  584. extern void xlbreak(char *emsg, LVAL arg);    /* enter break look */
  585. #ifdef COMMONLISP
  586. extern int xlcvttype(LVAL arg);
  587. #endif
  588.  
  589. #else
  590.  
  591. /* io interface */
  592. extern FILE *osaopen();    /* open ascii file */
  593. extern FILE *osbopen();    /* open binary file */
  594.  
  595. /* for xlisp.c */
  596. extern VOID xlrdsave();
  597. extern VOID xlevsave();
  598. extern VOID xlfatal();
  599. extern VOID wrapup();
  600.  
  601. /* for xleval */
  602. extern LVAL xlxeval();
  603. extern VOID xlabind();
  604. extern VOID xlfunbound();
  605. extern VOID xlargstkoverflow();
  606. extern VOID xlstkoverflow();
  607. extern LVAL makearglist();
  608. extern VOID xlunbound();
  609.  
  610. /* for xlprin */
  611. extern VOID xlputstr();
  612.  
  613. /* for xljump */
  614. extern VOID xljump();
  615.  
  616. /* for xlread */
  617. extern LVAL tentry();
  618.  
  619. /* for xlstruct */
  620. extern LVAL xlrdstruct();
  621.  
  622. /* external procedure declarations */
  623. extern VOID oscheck();            /* check for control character during exec */
  624. extern VOID xlsymbols();        /* initialize symbols */
  625. extern LVAL xleval();            /* evaluate an expression */
  626. extern LVAL xlapply();            /* apply a function to arguments */
  627. extern LVAL xlsubr();            /* enter a subr/fsubr */
  628. extern LVAL xlenter();            /* enter a symbol */
  629. extern LVAL xlmakesym();        /* make an uninterned symbol */
  630. extern LVAL xlgetvalue();        /* get value of a symbol (checked) */
  631. extern LVAL xlxgetvalue();        /* get value of a symbol */
  632. extern LVAL xlgetfunction();    /* get functional value of a symbol */
  633. extern LVAL xlxgetfunction();    /*get functional value of a symbol (checked)*/
  634. extern LVAL xlexpandmacros();    /* expand macros in a form */
  635. extern LVAL xlgetprop();        /* get the value of a property */
  636. extern LVAL xlclose();            /* create a function closure */
  637.  
  638. /* argument list parsing functions */
  639. extern LVAL xlgetfile();        /* get a file/stream argument */
  640. extern LVAL xlgetfname();        /* get a filename argument */
  641.  
  642. /* error reporting functions (don't *really* return at all) */
  643. extern LVAL xltoofew();            /* report "too few arguments" error */
  644. extern VOID xltoomany();        /* report too many arguments error */
  645. extern LVAL xlbadtype();        /* report "bad argument type" error */
  646. extern LVAL xlerror();            /* report arbitrary error */
  647. extern VOID xlerrprint();        /* print an error message */
  648. extern VOID xlbaktrace();        /* do a backtrace */
  649. #endif
  650.  
  651. #include "xlftab.h"
  652.